收集的stringgrid的技巧

StringGrid行列的增加和删除如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中stringgrid从文本读入的问题StringGrid组件Cells内容对齐StringGird的行列背景色设置怎么改变StringGrid控件某一列的背景和某一列的只读属性StringGrid控件标题栏的对齐怎么改变StringGrid控件某一列的背景和某一列的只读属性StringGrid控件标题栏的对齐在stringGrid中使用回车键模拟TAB键切换单元格的功能实现stringgrid如何清空让记录在StringGrid中分页显示在打印StringGrid如何实现在stringgrid中删除鼠标点中的那一行，下一行再顶上的效果让stringgrid点列头进行排序正确地设置StringGrid列宽而不截断任何一个文字方法实现StringGrid的删除，插入，排序行操作TstringGrid 的行列合并研究

StringGrid行列的增加和删除type TExCell = class(TStringGrid)

public procedure DeleteRow(ARow: Longint); procedure DeleteColumn(ACol: Longint); procedure InsertRow(ARow: LongInt); procedure InsertColumn(ACol: LongInt);end;

procedure TExCell.InsertColumn(ACol: Integer);begin ColCount :=ColCount +1; MoveColumn(ColCount-1, ACol);end;

procedure TExCell.InsertRow(ARow: Integer);begin RowCount :=RowCount +1; MoveRow(RowCount-1, ARow);end;

procedure TExCell.DeleteColumn(ACol: Longint);begin MoveColumn(ACol, ColCount -1); ColCount := ColCount - 1;end;

procedure TExCell.DeleteRow(ARow: Longint);begin MoveRow(ARow, RowCount - 1); RowCount := RowCount - 1;end;

  如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样 unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;

type TForm1 = class(TForm) grid: TStringGrid; procedure FormCreate(Sender: TObject); procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure gridClick(Sender: TObject);

 private{ Private declarations }

 public{ Public declarations }

end;

var Form1: TForm1; fcheck,fnocheck:tbitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);var i:SmallInt; bmp:TBitmap;begin FCheck:= TBitmap.Create; FNoCheck:= TBitmap.Create; bmp:= TBitmap.create; try   bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));   With FNoCheck Do Begin     width := bmp.width div 4;     height := bmp.height div 3;     canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );   End; With FCheck Do Begin   width := bmp.width div 4;   height := bmp.height div 3;   canvas.copyrect(canvas.cliprect, bmp.canvas, rect( width, 0, 2*width, height )); End; finally   bmp.free end;end;

procedure TForm1.gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);begin if not (gdFixed in State) then   with TStringGrid(Sender).Canvas do begin   brush.Color:=clWindow;   FillRect(Rect);   if Grid.Cells[ACol,ARow]='yes' then     Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FCheck )   else     Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FNoCheck ); end;end;

procedure TForm1.gridClick(Sender: TObject);begin if grid.Cells[grid.col,grid.row]='yes' then   grid.Cells[grid.col,grid.row]:='no' else   grid.Cells[grid.col,grid.row]:='yes';end;

end.

 2003-11-17 16:23:23    StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中：

 DrawText(StringGrid1.Canvas.Handle,pchar(StringGrid1.Cells[Acol,Arow]),Length(StringGrid1.Cells[Acol,Arow]),Rect,DT_WORDBREAK or DT_LEFT);

可以实现文字换行！

 2003-11-17 16:24:04    在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中,加入: (所有的列均设成可修改的)

 if Col mod 2 = 0 then   grd.Options := grd.Options + [goEditing] else   grd.Options := grd.Options - [goEditing];

 2003-11-17 16:25:07    stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）

// Save a TStringGrid to a fileprocedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);var f: TextFile; i, k: Integer;begin AssignFile(f, FileName); Rewrite(f); with StringGrid do begin   // Write number of Columns/Rows   Writeln(f, ColCount);   Writeln(f, RowCount);   // loop through cells   for i := 0 to ColCount - 1 do     for k := 0 to RowCount - 1 do       Writeln(F, Cells[i, k]); end; CloseFile(F);end;

// Load a TStringGrid from a fileprocedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);var f: TextFile; iTmp, i, k: Integer; strTemp: String;begin AssignFile(f, FileName); Reset(f); with StringGrid do begin   // Get number of columns   Readln(f, iTmp);   ColCount := iTmp;   // Get number of rows   Readln(f, iTmp);   RowCount := iTmp;   // loop through cells & fill in values   for i := 0 to ColCount - 1 do     for k := 0 to RowCount - 1 do     begin       Readln(f, strTemp);       Cells[i, k] := strTemp;     end;   end; CloseFile(f);end;

// Save StringGrid1 to 'c:.txt':procedure TForm1.Button1Click(Sender: TObject);begin SaveStringGrid(StringGrid1, 'c:.txt');end;

// Load StringGrid1 from 'c:.txt':procedure TForm1.Button2Click(Sender: TObject);begin LoadStringGrid(StringGrid1, 'c:.txt');end;

*******************************************

打开一个已有的文本文件,并将内容放到stringgrid中,文本行与stringgrid行一致;在文本中遇到空格则放入下一cells.搞定！注意，我只写了一个空格间隔的，你自己修改一下splitstring可以用多个空格分隔！

procedure TForm1.Button1Click(Sender: TObject);var aa,bb:tstringlist; i:integer;begin aa:=tstringlist.Create; bb:=tstringlist.Create; aa.LoadFromFile('c:.txt'); for i:=0 to aa.Count-1 do begin   bb:=SplitString(aa.Strings[i],' ');   stringgrid1.Rows[i]:=bb; end; aa.Free; bb.Free;end;

其中splitstring为：

function SplitString(const source,ch:string):tstringlist;var temp:string; i:integer;begin result:=tstringlist.Create; temp:=source; i:=pos(ch,source); while i0 do begin   result.Add(copy(temp,0,i-1));   delete(temp,1,i);   i:=pos(ch,temp); end; result.Add(temp);end;

StringGrid组件Cells内容对齐

在StringGrid的DrawCell事件中添加类似的代码就可以了：

VAR vCol, vRow : LongInt;begin vCol := ACol; vRow := ARow; WITH Sender AS TStringGrid, Canvas DO   IF vCol = 2 THEN BEGIN ///对于第2列设置为右对齐     SetTextAlign(Handle, TA_RIGHT);     FillRect(Rect);     TextRect(Rect, Rect.RIGHT-2, Rect.Top+2, Cells[vCol, vRow]);   END;end;

 2003-11-17 16:28:41    当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;Rect: TRect; State: TGridDrawState);begin With StringGrid1 do begin   If  (ARow= Krow) and not (acol = 0) then   begin      Canvas.Brush.Color :=clYellow;// ClBlue;      Canvas.FillRect(Rect);      Canvas.font.color:=ClBlack;      Canvas.TextOut(rect.left , rect.top, cells[acol, arow]);   end; end;end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);begin krow := Arow;  //* kcol := Acol;end;

注意：必须把变量KROW的值初始为1或其他不为0的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。

 2003-11-17 16:32:44    怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.请参考以下代码： 在OnDrawCell事件中处理背景色。程序如下：//将第二列背景变为红色。procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);begin if not((acol=1) and (arow>=stringgrid1.fixedrows)) then exit; with stringgrid1 do begin   canvas.Brush.color:=clRed;   canvas.FillRect(Rect);   canvas.TextOut(rect.left+2,rect.top+2,cells[acol,arow]) end;end;

//加入如下代码,那么StringGrid的第四列就只读了.其他列非只读procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);begin with StringGrid1 do begin   if ACol = 4 then     Options := Options - [goEditing]   else Options := Options + [goEditing];end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);var dx,dy:byte;begin if (acol = 4) and not (arow = 0) then   with stringgrid1 do   begin     canvas.Brush.color := clYellow;     canvas.FillRect(Rect);     canvas.font.color := clblue;     dx:=2;//调整此值，控制字在网格中显示的水平位置     dy:=2;//调整此值，控制字在网格中显示的垂直位置     canvas.TextOut(rect.left+dx , rect.top+dy , cells[acol, arow]);   end;//控制标题栏的对齐 if (arow = 0) then   with stringgrid1 do   begin     canvas.Brush.color := clbtnface;     canvas.FillRect(Rect);     dx := 12; //调整此值，控制字在网格中显示的水平位置     dy := 5; //调整此值，控制字在网格中显示的垂直位置     canvas.TextOut(rect.left + dx, rect.top + dy, cells[acol, arow]);   end;end;

 2003-11-17 16:37:15    在stringGrid中使用回车键模拟TAB键切换单元格的功能实现......procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char); label nexttab;begin if key=#13 then begin   key:=#0;   nexttab:   if (stringgrid1.Col=stringgrid1.RowCount-1 then       stringgrid1.RowCount:=stringgrid1.rowCount+1;     stringgrid1.Row:=stringgrid1.Row+1;     stringgrid1.Col:=0;     goto nexttab;   end; end;end;.........

 2003-11-17 16:42:17    stringgrid如何清空with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear;

 2003-11-17 16:44:00    选中某单元格,然后在该单元格中修改-> 选中某单元格,然后在该单元格中修改

设置属性:   StringGrid1.Options:=StringGrid1.Options+[goEditing];

 2003-11-17 16:46:14    让记录在StringGrid中分页显示在Uses中加入： ADOInt

//首先设定PageSize，取出PageCountprocedure TForm1.Button1Click(Sender: TObject);begin ADoquery1.Recordset.PageSize :=spinedit1.Value; Edit1.Text := IntToStr(ADoquery1.Recordset.PageCount); ShowData(spinedit2.Value);end;

//然后将AbsolutePage的数据乾坤大挪移到StringGrid1中procedure TForm1.ShowData(page:integer);var iRow, iCol, iCount : Integer; rs : ADOInt.Recordset;begin ADoquery1.Recordset.AbsolutePage:=Page; Currpage:=page; iRow := 0; iCol := 1; stringgrid1.Cells[iCol, iRow] := 'FixedCol1'; Inc(iCol); stringgrid1.Cells[iCol, iRow] := 'FixedCol2'; Inc(iRow); Dec(iCol); rs := adoquery1.Recordset; for iCount := 1 to SpinEdit1.Value do begin   stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;   Inc(iCol);   stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;   Inc(iRow);   Dec(iCol);   rs.MoveNext; end;

//上一页procedure TForm1.Button2Click(Sender: TObject);begin If (CurrPage)1 then   ShowData(CurrPage-1);end;

//下一页procedure TForm1.Button3Click(Sender: TObject);begin If CurrPageADoquery1.Recordset.PageCount then   ShowData(CurrPage+1);end;

 2003-11-17 16:48:51    打印StringGrid的程序源码这段代码没有看懂，但是可能有的朋友需要，所以共享一下子 ：）

procedure TForm1.SpeedButton11Click(Sender: TObject);Var Index_R ,ALeft: Integer; Index : Integer;begin StringGrid_File('D:/AAA.TXT'); if Not LinkTextFile then begin   ShowMessage('失败');   Exit; end; // QuickRep1.DataSet := ADOTable1; Index_R := ReSize(StringGrid1.Width); ALeft := 13; Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[0].Width,20,    HeaderControl1.Sections[0].Text,taLeftJustify); with Create_QRDBText(DetailBand1,ALeft,8,StringGrid1.ColWidths[0],20,        StringGrid1.Font,taLeftJustify) do begin   DataSet := ADOTable1;   DataField := ADOTable1.Fields[0].DisplayName; end; ALeft := ALeft + StringGrid1.ColWidths[0] * Index_R + Index_R; For Index := 1 to ADOTable1.FieldCount - 1 do begin   Create_VLine(TitleBand1,ALeft - 13,16,1,40);   Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[Index].Width,20,     HeaderControl1.Sections[Index].Text,taLeftJustify);   Create_VLine(DetailBand1,ALeft - 13,-1,1,31);   with Create_QRDBText(DetailBand1,ALeft ,8,StringGrid1.ColWidths[Index] * Index_R,20,        StringGrid1.Font,taLeftJustify) do   begin     DataSet := ADOTable1;     DataField := ADOTable1.Fields[Index].DisplayName;   end;   ALeft := ALeft + StringGrid1.ColWidths[Index] *  Index_R + Index_R; end; QuickRep1.Preview;end;

function TForm1.ReSize(AGridWidth: Integer): Integer;begin Result := Trunc(718 / AGridWidth);end;

function TForm1.StringGrid_File(AFileName: String): Boolean;var StrValue : String; Index : Integer; ACol , ARow : Integer; AFileValue : System.TextFile;begin StrValue := ''; Try   AssignFile(AFileValue , AFileName);   ReWrite(AFileValue);   StrValue := HeaderControl1.Sections[0].Text;   For Index := 1 to HeaderControl1.Sections.Count - 1 do     StrValue := StrValue + ',' + HeaderControl1.Sections[Index].Text;   Writeln(AFileValue,StrValue);   StrValue := '';   For  ARow := 0 To StringGrid1.RowCount - 1 do   begin     StrValue := '';     StrValue := StringGrid1.Cells[0,ARow];     For ACol := 1 To StringGrid1.ColCount - 1 do     begin       StrValue := StrValue + ', ' + StringGrid1.Cells[ACol,ARow];     end;     Writeln(AFileValue,StrValue);   end; Finally   CloseFile(AFileValue); end;end;

function TForm1.LinkTextfile: Boolean;begin Result := False; with ADOTable1 do begin   {ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +                       'Data Source= D:/;Extended Properties=Text;' +                       'Persist Security Info=False';   TableName := 'AAA#TXT';   Open;       }   if Active then     Result := True; end;end;

function TForm1.Create_QRDBText(Sender: TWinControl; ALeft, ATop, AWidth, AHight: Integer; AFont: TFont; AAlignMent: TAlignment): TQRDBText;var AQRDBText : TQRDBText;begin AQRDBText := TQRDBText.Create(Nil); with AQRDBText do begin   Parent := Sender;   Left := ALeft;   Top := ATop;   Width := AWidth;   Height := AHight;   AlignMent := AAlignMent;   Font.Assign(AFont); end; Result := AQRDBText;end;

function TForm1.Create_VLine(Sender: TWinControl; ALeft, ATop, AWidth, AHight: Integer): TQRShape;var AQRShapeV : TQRShape;begin AQRShapeV := TQRShape.Create(Nil); with AQRShapeV do begin   Parent := Sender;   Left := ALeft;   Top := ATop;   Width := AWidth;   Height := AHight; end; Result := AQRShapeV;end;

procedure TForm1.Create_Title(Sender: TWinControl; ALeft, ATop, AWidth, AHight: Integer; ACaption: String; AAlignMent: TAlignment);var AQRLabel : TQRLabel;begin AQRLabel := TQRLabel.Create(Nil); with AQRLabel do begin   Parent := Sender;   Left := ALeft;   Top := ATop;   Width := AWidth;   AlignMent := AAlignMent;   Caption := ACaption; end;end;-----------------------------

 2003-11-17 17:00:09    如何实现在stringgrid中删除鼠标点中的那一行，下一行再顶上的效果？procedure TForm1.Button1Click(Sender: TObject);varSel : TGridRect;beginSel := StringGrid1.Selection;DeleteRow(Sel.Top);end;

// delete rowprocedure TForm1.DeleteRow(Row: Integer);vari : integer;beginif (Row < StringGrid1.RowCount) and (Row > Stringgrid1.FixedRows-1) then  if Row < StringGrid1.RowCount - 1 then  begin    for i := Row to StringGrid1.RowCount-1 do      StringGrid1.Rows[i] := StringGrid1.Rows[i+1];    StringGrid1.RowCount := StringGrid1.RowCount - 1;  end  else stringGrid1.Rows[Row].Clear;end;

 2003-11-17 17:10:56    让stringgrid点列头进行排序procedure GridQuickSort(Grid: TStringGrid; ACol: Integer; order: Boolean ; NumOrStr: Boolean);(******************************************************************************)(*  函数名称：GridQuickSort                                                   *)(*  函数功能：给 StringGrid 的 ACol 列快速法排序    _/_/     _/_/  _/_/_/_/_/ *)(*  参数说明:                                          _/   _/        _/      *)(*            Order: True 从小到大                       _/          _/       *)(*                 : False 从大到小                     _/          _/        *)(*        NumOrStr : true 值的类型是Integer          _/_/        _/_/         *)(*                 : False 值的类型是String                                   *)(*  函数说明：对于日期，时间等类型数据均可按字符方式排序，                    *)(*                                                                            *)(*                                                                            *)(*                                             Author: YuJie  2001-05-27      *)(*                                             Email : [email protected]     *)(******************************************************************************)procedure MoveStringGridData(Grid: TStringGrid; Sou,Des :Integer );var  TmpStrList: TStringList ;  K : Integer ;begin  try    TmpStrList :=TStringList.Create() ;    TmpStrList.Clear ;    for K := Grid.FixedCols to Grid.ColCount -1 do      TmpStrList.Add(Grid.Cells[K,Sou]) ;    Grid.Rows [Sou] := Grid.Rows [Des] ;    for K := Grid.FixedCols to Grid.ColCount -1 do      Grid.Cells [K,Des]:= TmpStrList.Strings[K] ;  finally    TmpStrList.Free ;  end;end;

procedure QuickSort(Grid: TStringGrid; iLo, iHi: Integer);var  Lo, Hi : Integer;  Mid: String ;begin  Lo := iLo ;  Hi := iHi ;  Mid := Grid.Cells[ACol,(Lo + Hi) div 2];  repeat    if order and not NumOrStr then //按正序、字符排    begin      while Grid.Cells[ACol,Lo] < Mid do Inc(Lo);      while Grid.Cells[ACol,Hi] > Mid do Dec(Hi);    end ;    if not order and not NumOrStr then //按反序、字符排    begin      while Grid.Cells[ACol,Lo] > Mid do Inc(Lo);      while Grid.Cells[ACol,Hi] < Mid do Dec(Hi);    end;

    if NumOrStr then    begin      if Grid.Cells[ACol,Lo] = '' then Grid.Cells[ACol,Lo] := '0' ;      if Grid.Cells[ACol,Hi] = '' then Grid.Cells[ACol,Hi] := '0' ;      if Mid = '' then Mid := '0' ;      if order then      begin //按正序、数字排        while StrToFloat(Grid.Cells[ACol,Lo]) < StrToFloat(Mid) do Inc(Lo);        while StrToFloat(Grid.Cells[ACol,Hi]) > StrToFloat(Mid) do Dec(Hi);      end else      begin //按反序、数字排        while StrToFloat(Grid.Cells[ACol,Lo]) > StrToFloat(Mid) do Inc(Lo);        while StrToFloat(Grid.Cells[ACol,Hi]) < StrToFloat(Mid) do Dec(Hi);      end;    end ;    if Lo Hi;  if Hi > iLo then QuickSort(Grid, iLo, Hi);  if Lo < iHi then QuickSort(Grid, Lo, iHi);end;

begintry  QuickSort(Grid, Grid.FixedRows, Grid.RowCount - 1 ) ;excepton E: Exception do  Application.MessageBox(Pchar('系统在排序数据的时候遇到异常:'#13+E.message+#13'请重试，如果该问题依然存在请与程序供应商联系！'),'系统错误',MB_OK+MB_ICONERROR) ;end;end;

procedure StringGridTitleDown(Sender: TObject;Button: TMouseButton;  X, Y: Integer);(******************************************************************************)(*  函数名称：StringGridTitleDown                                             *)(*  函数功能：取鼠标点StringGrid 的列                _/_/     _/_/  _/_/_/_/_/ *)(*  参数说明:                                          _/   _/        _/      *)(*            Sender                                     _/          _/       *)(*                                                      _/          _/        *)(*                                                   _/_/        _/_/         *)(*                                                                            *)(*                                                                            *)(*                                             Author: YuJie  2001-05-27      *)(*                                             Email : [email protected]     *)(******************************************************************************)varI: Integer ;beginif (Y > 0 ) and (y < TStringGrid(Sender).DefaultRowHeight * TStringGrid(Sender).FixedRows ) thenbegin  if  Button = mbLeft then  begin    I := X div  TStringGrid(Sender).DefaultColWidth ;    //这个i 就是要排序得行了    // 下面调用上面的排序函数就可以了，    GridQuickSort(TStringGrid(Sender), I, False, True) ;  end;end;end;

   用上面的两个函数就能解决你的问题了。在TStringGrid 的MouseDown事件中调用StringGridTitleDown 函数就可以。你可能要修改一下StringGridTitleDown函数来修改排序得方式及其字符类型。   提醒你一下对于日期、时间、布尔等类型数据均可按字符方式排序。例如：

procedure TForm_Main.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);beginStringGridTitleDown(Sender,Button,X,Y);end;

 2003-11-19 9:16:01    正确地设置StringGrid列宽而不截断任何一个文字方法是在对StringGrid填充完文本串后调用SetOptimalGridCellWidth过程。

 -----------程序片断------------------------------------------------- (* $Header$ Module Name : General/BSGrids.pas Main Program : Several. Description : StringGrid support functions. 03/21/2000 enhanced by William Sorensen *)

 unit BSGrids;

 interface

 uses   Grids;

 type   TExcludeColumns = set of 0..255;   procedure SetOptimalGridCellWidth(sg: TStringGrid;   ExcludeColumns: TExcludeColumns);   // Sets column widths of a StringGrid to avoid truncation of text.   // Fill grid with desired text strings first.   // If a column contains no text, DefaultColWidth will be used.   // Pass [] for ExcludeColumns to process all columns, including Fixed.   // Columns whose numbers (0-based) are specified in ExcludeColumns will not   // have their widths adjusted.

 implementation

 uses   Math; // we need the Max function   procedure SetOptimalGridCellWidth(sg: TStringGrid;   ExcludeColumns: TExcludeColumns);

 var   i : Integer;   j : Integer;   max_width : Integer; begin   with sg do   begin     // If the grid's Paint method hasn't been called yet,     // the grid's canvas won't use the right font for TextWidth.     // (TCustomGrid.Paint normally sets this, under DrawCells.)     Canvas.Font.Assign(Font);     for i := 0 to (ColCount - 1) do     begin       if i in ExcludeColumns then         Continue;       max_width := 0;       // Search for the maximal Text width of the current column.       for j := 0 to (RowCount - 1) do         max_width := Math.Max(max_width,Canvas.TextWidth(Cells[i,j]));       // The hardcode of 4 is based on twice the offset from the left       // margin in TStringGrid.DrawCell. GridLineWidth is not relevant.       if max_width > 0 then         ColWidths[i] := max_width + 4       else         ColWidths[i] := DefaultColWidth;     end; { for }   end; end;

 end.

 2003-11-19 9:22:09    实现StringGrid的删除，插入，排序行操作（基本操作啦）//实现删除操作 Procedure GridRemoveColumn(StrGrid: TStringGrid; DelColumn: Integer); Var Column: Integer; begin   If DelColumn = StrToInt(StrGrid.Cells[NoColumn-1,PosActual-1])) then       Break;       StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1];       Dec(PosActual);     End;     If StrToInt(Row.Strings[NoColumn-1]) < StrToInt(StrGrid.Cells[NoColumn-1,PosActual]) then       StrGrid.Rows[PosActual] := Row;   End;   Renglon.Free; end;

 2003-11-20 11:28:56    TstringGrid 的行列合并研究unit Unit1;

//建立一工程，//粘贴本单元代码即可看 STringGrid 行列合并效果//但发现非固定行非固定列的合并效果不好interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Db, ADODB, DBTables, Grids;//注意这里要引用

typeTForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure SGDrawCell(Sender: TObject; ACol, ARow: Integer;   Rect: TRect; State: TGridDrawState); procedure SGTopLeftChanged(Sender: TObject);private { Private declarations }public { Public declarations }end;

varForm1: TForm1;

implementation

{$R *.DFM}

// 以下 StringGrid 为固定行，固定列的合并所必须进行的处理// 非固定行，非固定列的合并效果不好varsg:TStringGrid;procedure TForm1.FormCreate(Sender: TObject);vari,j:integer ;beginSg:=TStringGrid.Create(self);

with SG dobegin parent:=self; align:=alclient; DefaultDrawing:=false; FixedColor:=clYellow; RowCount:=30; ColCount:=20; FixedCols:=1; FixedRows:=1; GridLineWidth:=0; Options:=Options+[goEditing]-[goVertLine,goHorzLine,goRangeSelect]; OnDrawCell:=SGDrawCell; OnTopLeftChanged:=SGTopLeftChanged; Canvas.Font.name:='宋体'; Canvas.Font.Size:=10;

 for i:=0 to colCount-1 do for j:=0 to RowCount-1 do   cells[i,j]:=Format('%d行%d列',[j,i]);

 for i:=0 to colCount-1 do   cells[i,0]:=Format('第%d列',[i]); for i:=0 to RowCount-1 do   cells[0,i]:=Format('第%d行',[i]);

 Cells[0,0]:='   左上角'; Cells[1,0]:='AA这是列合并BB'; Cells[0,1]:='A这是行'#10'合并BB'; Cells[1,1]:='1111111'; Cells[1,2]:='1111222'; Cells[2,1]:='2222111'; Cells[2,2]:='2222222';end;end;

//重载 OnDrawCell 事件procedure TForm1.SGDrawCell(Sender: TObject; ACol, ARow: Integer;Rect: TRect; State: TGridDrawState);varr:TRect;d:TStringGrid;s:string;ts:TStrings;i,n:integer;fixed:Boolean;begind:=TStringGrid(sender);if (Acol=2) and (ARow=0) thenbegin r.left:=Rect.left-1-d.colwidths[ACol-1]; r.top:=rect.top-1; r.right:=rect.right; r.bottom:=rect.bottom; s:=d.cells[ACol-1,ARow];end elseif (Acol=1) and (ARow=0) thenbegin r.left:=Rect.left-1; r.top:=rect.top-1; r.right:=rect.right+d.colwidths[ACol+1]; r.bottom:=rect.bottom; s:=d.cells[ACol,ARow];end   //以上列合并elseif (Acol=0) and (ARow=2) thenbegin r.left:=Rect.left-1; r.top:=rect.top-1-d.RowHeights[ARow-1]; r.right:=rect.right; r.bottom:=rect.bottom; s:=d.cells[ACol,ARow-1];end elseif (Acol=1) and (ARow=0) thenbegin r.left:=Rect.left-1; r.top:=rect.top-1; r.right:=rect.right; r.bottom:=rect.bottom+d.RowHeights[ARow+1]; s:=d.cells[ACol,ARow];end  以上为行合并elsebegin r.left:=Rect.left-1; r.top:=rect.top-1; r.right:=rect.right; r.bottom:=rect.bottom; s:=d.cells[ACol,ARow];end;

d.Canvas.brush.color:=d.color;d.canvas.Font.color:=$ff0000;

Fixed:=false;if (Arow